(*****************************************************************************
 * Delphi Plug-in Framework (DPF)
 * Copyright (C) 2006-2007 Tao Yuan
 *
 * The contents of this file are subject to the Mozilla Public License
 * Version 1.1 (the "License"); you may not use this file except in compliance
 * with the License. You may obtain a copy of the
 * License at http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
 * the specific language governing rights and limitations under the License.                                                               }
 *
 * The Initial Developer of the Original Code is Tao Yuan. Portions created by
 * Tao Yuan are Copyright (C) Tao Yuan (taoy.cn att gmail dott com)
 * All rights reserved.
 *****************************************************************************)
 
unit RdControlThread;

interface

uses
  Classes,  
  Rcl,
  RdApplicationHelp, RdServiceApplication, RdSocketStream;

type
  TControlThread = class(TThread)
  private
    log: ILog;

    serverSocket: TSocketStream;
    app: IServiceApplication;
    appIntfs: TApplicationIntfs;
    appRunning: Boolean;

    procedure debug(msg: string);
    procedure error(msg: string);
    function handleRequest(clientSocket: TSocketStream): Boolean;
    function isValidRemoteHost(clientSocket: TSocketStream): Boolean;
    procedure stopApplication;
    procedure warn(msg: string);
  protected
    procedure Execute; override;
  public
    constructor Create(host: string; port: Integer; appIntfs: TApplicationIntfs);
    class function isApplicationRunning(host: string; port: Integer): Boolean;
    class function stopRunningApplication(host: string; port: Integer): Boolean;
  end;

implementation

uses
  SysUtils,
  DPFLog,
  RdBoot;

{ TControlThread }

constructor TControlThread.Create(host: string; port: Integer; appIntfs:
    TApplicationIntfs);
begin
  Inherited Create(True);
  log := DPFLog.LogFactory.getLogger(Self);
  Self.appIntfs := appIntfs;
  app := IServiceApplication(appIntfs.App);;
  serverSocket := TSocketStream.Create;
  serverSocket.Listen(host, port);
  appRunning := True;
end;

procedure TControlThread.debug(msg: string);
begin
  if log <> nil then
    log.debug(msg)
  else
    ;
end;

procedure TControlThread.error(msg: string);
begin
  if log <> nil then
    log.error(msg)
  else
    ;
end;

procedure TControlThread.Execute;
var
  clientSocket: TSocketStream;
begin  
  try  
    while (true) do
      try
        if serverSocket.CanAccept then
        begin
          clientSocket := serverSocket.accept;
          try
              if (handleRequest(clientSocket)) then
                  break;

          finally
              try
                  clientSocket.Free;
              except
                  // ignore
              end;
          end;
        end;
      except
        warn('error on server socket'); //$NON-NLS-1$
        Break;            
      end;
  finally
      try 
          serverSocket.close();
      except
          warn('error closing server socket'); //$NON-NLS-1$
      end;
      if (appRunning) then
          stopApplication();  
  end;
end;

function TControlThread.handleRequest(clientSocket: TSocketStream): Boolean;
var
  commandResult: string;
  buf: array[0..127] of Char;
  len: Integer;
  command: string;
begin
  debug('handling control request'); //$NON-NLS-1$
  if (not isValidRemoteHost(clientSocket)) then
  begin
      warn('incoming connection to control socket registered' //$NON-NLS-1$
              + ' from REMOTE address ' + clientSocket.RemoteHost //$NON-NLS-1$
              + ', attempt to execute command was IGNORED'); //$NON-NLS-1$
      try
          clientSocket.Close;
      except
          // ignore
      end;
      Result := False;
  end;
  debug('processing control request'); //$NON-NLS-1$
  Result := False;
  try
      FillChar(buf, Length(buf), 0);
      try
          len := clientSocket.Read(buf[0], Length(buf));
          while (len <> -1) do
          begin
              command := command + buf;
              FillChar(buf, Length(buf), 0);
              len := clientSocket.Read(buf[0], Length(buf));
          end;

//          clientSocket.shutdownInput();
          debug('got command - ' + command); //$NON-NLS-1$
          if Rcl.Str.IsEqual('STOP', command) then //$NON-NLS-1$
          begin
              stopApplication();
              result := true;
              commandResult := 'OK: stop done'; //$NON-NLS-1$
          end else if Rcl.Str.StartsWith(command, 'PING') then //$NON-NLS-1$
              commandResult := 'OK: ' //$NON-NLS-1$
                  + Rcl.Str.SubString(command, Length('PING'))
          else
              commandResult := 'ERROR: unknown command'; //$NON-NLS-1$
          
          //debug('command executed');
          //debug('sending command result - ' + commandResult);
          clientSocket.Write(commandResult[1], Length(commandResult))
//          out = clientSocket.getOutputStream();
//          out.write(commandResult.getBytes());
//          out.flush();
//          clientSocket.shutdownOutput();
          //debug('command result sent');
      finally 
//          try
//              in.close();
//          } catch (IOException ioe) {
//              // ignore
//          }
//          if (out != null) {
//              try {
//                  out.close();
//              } catch (IOException ioe) {
//                  // ignore
//              }
//          }
      end;
  except
    on e: Exception do
      error('error processing control request'); //$NON-NLS-1$
  end;
end;

class function TControlThread.isApplicationRunning(host: string; port:
    Integer): Boolean;
begin
  Result := True;
end;

function TControlThread.isValidRemoteHost(clientSocket: TSocketStream): Boolean;
begin
  Result := (clientSocket.LocalHost = serverSocket.LocalHost);
end;

procedure TControlThread.stopApplication;
begin
  if (not appRunning) then
  begin
      debug('application not running'); //$NON-NLS-1$
      Exit;
  end;
  appRunning := false;
  debug('stopping application'); //$NON-NLS-1$
  try
      TBoot.stopApplication(appIntfs);
      log := nil;
  except
      error('an error has occurred while stopping' //$NON-NLS-1$
              + ' application'); //$NON-NLS-1$
  end;
  debug('application stopped from control thread'); //$NON-NLS-1$
end;

class function TControlThread.stopRunningApplication(host: string; port:
    Integer): Boolean;
begin

end;

procedure TControlThread.warn(msg: string);
begin
  if log <> nil then
    log.warn(msg)
  else
    ;
end;

end.
